home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / statz13.arc / STATZ13.BAS < prev   
BASIC Source File  |  1987-02-07  |  24KB  |  379 lines
  1. 10    '************************************************************************        **************************  STATZ.BAS  *********************************        ************************************************************************
  2. 20    '                                                                                ------------------------------------------------------------------------            Program for statistical manipulation of keyboard-entered data.
  3. 30    '------------------------------------------------------------------------
  4. 100   CLEAR
  5. 102   DEF SEG=&HF000:IF PEEK(&HFFFE)=&HFC THEN MACHINE$="AT"
  6. 105   GOSUB 15000
  7. 110   KEY OFF
  8. 120   KEY 1,CHR$(27)+"GOTO 27000"+CHR$(13)
  9. 130   KEY 2,CHR$(27)+"RUN"+CHR$(13)
  10. 140   KEY 3,CHR$(27)+"COLOR 6,0"+CHR$(13)
  11. 150   KEY 10,CHR$(24)
  12. 160   DEFINT C,F,I,J,K,L,N,Z
  13. 170   FC=6:BC=0:FC2=3
  14. 200   OPTION BASE 1
  15. 210   DIM X(300), Y(300), Z(300), TVAL(34,10), PVAL$(9)
  16. 250   DEF FNNUM$(X)=RIGHT$(STR$(X),LEN(STR$(X))-1)
  17. 500   FOR J=1 TO 34
  18. 510     FOR K=1 TO 10
  19. 520       READ TVAL(J,K)
  20. 530     NEXT K
  21. 540   NEXT J
  22. 550   FOR J=1 TO 9:READ PVAL$(J):NEXT
  23. 570   LOCATE 25,22:COLOR 1,7:PRINT" ** PRESS ANY KEY TO CONTINUE ** ";:                 COLOR FC,BC
  24. 580   W$=INKEY$:IF W$="" THEN 580
  25. 999   '                                                                               '********************  KEYBOARD INPUT MENU  *****************************       '
  26. 1000  MENU=0:BLINE=1:BCOL=2:BXL=20:BXW=76:LABEL$="":LL=1:BORDER=2:GOSUB 24000
  27. 1010   LOCATE 3,26:COLOR 12:PRINT"INDICATE YOUR DESIRED OPTION"
  28. 1020   LOCATE 6,5:COLOR 6:PRINT"1.  MEAN, STANDARD DEVIATION, SEM, MEDIAN OF O";         "NE VARIABLE"
  29. 1030   LOCATE 8, 5:PRINT"2.  MEANS, VARIANCES, AND LINEAR REGRESSION DATA ON T";         "WO VARIABLES"
  30. 1040   LOCATE 10,5: PRINT "3.  STUDENT t-TEST, NON-PAIRED DATA"
  31. 1050   LOCATE 12,5: PRINT "4.  STUDENT t-TEST, PAIRED DATA"
  32. 1060   LOCATE 14,5: PRINT "5.  CHI-SQUARE TEST
  33. 1070   LOCATE 16,5: PRINT "6.  RETURN TO DOS"
  34. 1080   LOCATE 19,30:COLOR 12:PRINT "YOUR CHOICE:  ";
  35. 1090   L$ = "49": H$ = "54": INLEN = 1: DEFLT$ = ""
  36. 1100   LOCATE, 45: GOSUB 20000: KCHO = VAL(BUFF$): IF KCHO = 0 THEN 1080
  37. 1110   MENU=1:ON KCHO GOTO 2000, 3000, 5000, 8000, 9000, 1120
  38. 1120   CLS:SYSTEM
  39. 1999   '                                                                               '**********************  MEAN, SD, SEM, MEDIAN  *************************       '
  40. 2000  IF MACHINE$<>"AT" THEN GOSUB 2500 ELSE MEDN=1
  41. 2030   CLS:MENU=1:GOSUB 28010
  42. 2040   SMX=0:X=0:N=0:SMSQX=0
  43. 2050   ERASE X
  44. 2055   LOCATE 1,25:COLOR 0,7:PRINT" **  BASIC STATISTICS  ** ":COLOR FC,BC
  45. 2060   LOCATE 3,10: PRINT "ENTER VALUE.  ENTER [ / ] TO END LIST."
  46. 2070   DEF SEG=0:POKE 1047,(PEEK(1047) OR 32):GOSUB 2380
  47. 2080   LOCATE 5:L$ = "43": H$ = "57": INLEN = 8: DEFLT$ = "0"
  48. 2090   FOR J = 0 TO 6
  49. 2100     JJ = 152*J
  50. 2110     FOR K = 0 TO 7
  51. 2120       KK = 19*K
  52. 2130       FOR N = 1 TO 19
  53. 2140         NN = JJ + KK + N
  54. 2150         LOCATE (N + 4), (10*K + 1)
  55. 2160         GOSUB 2380:GOSUB 20000: IF BUFF$ = "/" THEN 2230
  56. 2170         X(NN) = VAL(BUFF$)
  57. 2180         SMX = SMX + X(NN): SMSQX = SMSQX + X(NN)*X(NN)
  58. 2190       NEXT N
  59. 2200     NEXT K
  60. 2210     CLS
  61. 2220   NEXT J
  62. 2230   N = (JJ + KK + N -1)
  63. 2240  CLS: GOSUB 4000
  64. 2250  CLS: GOSUB 28000: COLOR 1: LOCATE 2,10: PRINT NAMV$: COLOR 6
  65. 2260  PRINT:PRINT TAB(10)"MEAN";:COLOR 3:PRINT TAB(30) MNX:COLOR 6
  66. 2270  PRINT:PRINT TAB(10)"STANDARD DEVIATION";:COLOR 3:PRINT TAB(30)SDX:COLOR 6
  67. 2280  PRINT:PRINT TAB(10)"STD ERROR OF MEAN";:COLOR 3:PRINT TAB(30)SEMX:COLOR 6
  68. 2290  IF MEDN THEN PRINT:PRINT TAB(10)"MEDIAN";:COLOR 3:PRINT TAB(30)MEDX:              COLOR 6
  69. 2300  PRINT:PRINT TAB(10)"N";:COLOR 3:PRINT TAB(30)N:COLOR 4,7
  70. 2310  LOCATE 18,15:PRINT "DO YOU WANT FURTHER TESTING?  ";:COLOR FC,BC
  71. 2320  L$ = "78": H$ = "121": INLEN = 1: DEFLT$ = "Y"
  72. 2330  LOCATE, 47: GOSUB 20000: YN$ = BUFF$
  73. 2340  IF YN$ = "Y" THEN 2030 ELSE GOTO 1000
  74. 2370  '
  75. 2380  Y=CSRLIN:Z=POS(X):DEF SEG=0:COLOR 12:LOCATE 1,65:IF (PEEK(1047) AND 32)=32        THEN PRINT"NUM LOCK ON " ELSE PRINT "NUM LOCK OFF"
  76. 2390  LOCATE Y,Z:RETURN
  77. 2400  LOCATE Y,Z:RETURN
  78. 2499  '                                                                               '------------------------- MEDIAN SELECTION SR  -------------------------       '
  79. 2500  BLINE=4:BCOL=8:BXL=4:BXW=54:BORDER=1:LL=1:LABEL$="":GOSUB 24000
  80. 2510  LOCATE 5,10:PRINT"THE CALCULATION OF MEDIANS REQUIRES A LONGER TIME:"
  81. 2520  LOCATE 7,15: PRINT "DO YOU WANT MEDIANS? [Y/N]:":L$="78":H$="121":                INLEN=1:DEFLT$="N":LOCATE 7,50:GOSUB 20000:YN$=BUFF$
  82. 2530  IF YN$="Y" THEN MEDN=1 ELSE MEDN=0
  83. 2540  RETURN
  84. 2999  '                                                                               '*******************  KEYBOARD INPUT, TWO VARIABLES  ********************       '
  85. 3000  CLS:GOSUB 28000:LOCATE 1,25:COLOR 0,7:PRINT" **  LINEAR REGRESSION  ** ":         COLOR FC,BC
  86. 3005  LOCATE 3,10:PRINT"ENTER NAME OF X VARIABLE:  ";:LOCATE,40:L$="32":H$="122"        :INLEN=10:DEFLT$="":GOSUB 20000:NAMVX$=BUFF$
  87. 3010  PRINT:LOCATE 4,10:PRINT"ENTER NAME OF Y VARIABLE:  ";:LOCATE,40:GOSUB             20000:NAMVY$=BUFF$
  88. 3020  SMX=0:SMY=0:SMSQX=0:SMSQY=0:SMXY=0:ERASE X,Y
  89. 3040  LOCATE 6,10: PRINT "ENTER X AND Y DATA PAIRS.  ENTER [ / ] TO END LIST."
  90. 3050  COLOR FC,BC:L$="45":H$="57":INLEN=8:DEFLT$="0"
  91. 3060  FOR J = 0 TO 12
  92. 3070    JJ = 72*J
  93. 3080    FOR K = 0 TO 3
  94. 3090      KK = 16*K
  95. 3100      LOCATE 8,(20*K+1):COLOR 1,7:PRINT NAMVX$:LOCATE 8,(20*K+11):COLOR,6:              PRINT NAMVY$:COLOR 6,0
  96. 3110      FOR N = 1 TO 16
  97. 3120        NN = JJ + KK + N
  98. 3130        LOCATE (N+8), (20*K + 1): GOSUB 20000: IF BUFF$ = "/" THEN 3260
  99. 3140          X(NN) = VAL(BUFF$)
  100. 3150        LOCATE (N+8),(20*K+11):GOSUB 20000:Y(NN)=VAL(BUFF$):
  101. 3160        SMX = SMX + X(NN)
  102. 3170        SMY = SMY + Y(NN)
  103. 3180        SMSQX = SMSQX + X(NN)*X(NN)
  104. 3190        SMSQY = SMSQY + Y(NN)*Y(NN)
  105. 3200        SMXY = SMXY + X(NN)*Y(NN)
  106. 3210      NEXT N
  107. 3220      COLOR 14:FOR I = 1 TO 17:                                                         LOCATE (7+I), (19+20*K): PRINT CHR$(179);:                                    NEXT I:COLOR FC
  108. 3230    NEXT K
  109. 3240    CLS
  110. 3250  NEXT J
  111. 3260  N = NN -1
  112. 3270  CLS: GOSUB 4800
  113. 3280  IF MACHINE$<>"AT" THEN GOSUB 2500 ELSE MEDN=1
  114. 3285  GOSUB 4000
  115. 3290  LOCATE 4,1:COLOR 4,7:PRINT NAMVX$+" (= X) ":COLOR 6,0
  116. 3300  FM$="#####.###"
  117. 3305  FORM$="\             \" + "####.###"
  118. 3310  LOCATE 7,1:PRINT"MEAN";:LOCATE,11:COLOR 7:PRINT USING FM$;MNX
  119. 3320  LOCATE 9,1:COLOR 6:PRINT"S.D.";:LOCATE,11:COLOR 7:PRINT USING FM$;SDX
  120. 3330  LOCATE 11,1:COLOR 6:PRINT"S.E.M.";:LOCATE,11:COLOR 7:PRINT USING FM$;SEMX
  121. 3340  LOCATE 13,1:COLOR 6:PRINT"MEDIAN";:LOCATE,11:COLOR 7:PRINT USING FM$;MEDX
  122. 3350  LOCATE 15,1:COLOR 6:PRINT"N";:LOCATE,11:COLOR 7:PRINT USING FM$;N
  123. 3360  SWAP SMX,SMY: SWAP SMSQX, SMSQY
  124. 3370  FOR Z = 1 TO N: X(Z) = Y(Z): NEXT Z
  125. 3380  GOSUB 4000
  126. 3390  SWAP SMX,SMY: SWAP SMSQX, SMSQY
  127. 3400  LOCATE 4,26: COLOR 4,7:PRINT NAMVY$+" (= Y)":COLOR 6,0
  128. 3410  LOCATE 7,26:PRINT"MEAN";:LOCATE,36:COLOR 7:PRINT USING FM$;MNX
  129. 3420  LOCATE 9,26:COLOR 6:PRINT"S.D.";:LOCATE,36:COLOR 7:PRINT USING FM$;SDX
  130. 3430  LOCATE 11,26:COLOR 6:PRINT"S.E.M.";:LOCATE,36:COLOR 7:PRINT USING FM$;SEMX
  131. 3440  LOCATE 13,26:COLOR 6:PRINT"MEDIAN";:LOCATE,36:COLOR 7:PRINT USING FM$;MEDX
  132. 3450  LOCATE 15,26:COLOR 6:PRINT"N";:LOCATE,36:COLOR 7:PRINT USING FM$;N
  133. 3460  LOCATE 4, 56: COLOR 1,7:PRINT" REGRESSION DATA ":COLOR 2,0
  134. 3470  LOCATE 7, 52:PRINT"SLOPE ";:LOCATE,66:COLOR 7:PRINT USING"####.#####";            SLOPE:COLOR 2,0
  135. 3480  LOCATE 9,52:PRINT"Y INTERCEPT";:LOCATE,66:COLOR 7:PRINT USING"####.###";          YINT:COLOR 2
  136. 3490  LOCATE 11,52:PRINT"R (CORR.COEFF.)";:LOCATE,69:COLOR 7:PRINT USING                "#.#####";R
  137. 3500  LOCATE 22:COLOR 0,7:PRINT" **  PRESS ANY KEY TO CONTINUE  ** ":COLOR FC,BC
  138. 3510  W$=INKEY$:IF W$="" THEN 3510 ELSE GOTO 1000
  139. 3999  '                                                                               '*****************  BASIC STATISTICS, SINGLE VARIABLE  ******************       '
  140. 4000  IF N = 0 THEN MNX=0: SDX=0: SEMX=0: MEDX=0: RETURN
  141. 4010  MNX = SMX/N
  142. 4020  IF N > 1 THEN Z = N - 1 ELSE Z = N
  143. 4030  VRNCX = (SMSQX - (SMX*SMX)/N)/Z
  144. 4040  SDX = SQR(VRNCX)
  145. 4050  SEMX = SDX/SQR(N)
  146. 4060  IF NOMED = 1 THEN RETURN
  147. 4070  IF MEDN=1 THEN GOSUB 4500
  148. 4080  RETURN
  149. 4499  '                                                                               '-------------------------------  MEDIAN  -------------------------------       '
  150. 4500  M = N
  151. 4510  IF N = 0 THEN RETURN
  152. 4520  M = INT(M/2)
  153. 4530  IF M = 0 THEN 4650
  154. 4540  J = 1: K = N - M
  155. 4550  I = J
  156. 4560  L = I + M:Z=Z+1:LOCATE 1,1:PRINT Z
  157. 4570  IF X(I) < X(L) THEN 4620
  158. 4580  SWAP X(I), X(L)
  159. 4590  I = I - M
  160. 4600  IF I < 1 THEN 4620
  161. 4610  GOTO 4560
  162. 4620  J = J + 1
  163. 4630  IF J > K THEN 4520
  164. 4640  GOTO 4550
  165. 4650  IF N/2 - INT(N/2) <> 0 THEN 4670
  166. 4660  MEDX = (X(N/2) + X(1 + N/2))/2: GOTO 4680
  167. 4670  MEDX = X(N/2)
  168. 4680  RETURN
  169. 4799  '                                                                               '------------------  LINEAR CORRELATION, REGRESSION  --------------------       '
  170. 4800  IF N=0 OR N*SMSQX-SMX*SMX=0 THEN YINT=0: R=0: SLOPE=0: RETURN
  171. 4810  SLOPE = (N*SMXY - SMX*SMY)/(N*SMSQX - SMX*SMX)
  172. 4820  YINT = SMY/N - SLOPE*SMX/N
  173. 4830  IF N*SMSQY - SMY*SMY = 0 THEN R = 0: RETURN
  174. 4840  R = (N*SMXY - SMX*SMY)/SQR((N*SMSQX - SMX*SMX)*(N*SMSQY - SMY*SMY))
  175. 4850  RETURN
  176. 4999  '                                                                               '***************** STUDENT t-TEST FOR UNPAIRED VARIABLES ****************       '
  177. 5000  CLS:MENU=2:GOSUB 28000:LOCATE 2,20:COLOR 4:PRINT"STUDENT t-TEST FOR ";            "UNPAIRED VARIABLES": COLOR FC
  178. 5010  COLOR 14:LOCATE 1,1:PRINT STRING$(80,196);
  179. 5020  LOCATE 3,1:PRINT STRING$(80,196);:COLOR FC,BC
  180. 5030  LOCATE 5,1:PRINT"ENTER MEAN, STANDARD DEVIATION, AND NUMBER OF SAMPLES" +         " OF FIRST DISTRIBUTION:"
  181. 5040  L$ = "45": H$ = "57": INLEN = 8: DEFLT$ = "0"
  182. 5050  LOCATE 7,5: PRINT "MEAN:";: LOCATE,12: GOSUB 20000: M1 = VAL(BUFF$)
  183. 5060  LOCATE 7,24: PRINT "STD DEV:";: LOCATE,35: GOSUB 20000: SD1 = VAL(BUFF$)
  184. 5070  LOCATE 7,50: PRINT "N:";: LOCATE,56: INLEN = 4: GOSUB 20000:                      N1 = VAL(BUFF$)
  185. 5080  LOCATE 10,1:PRINT"ENTER MEAN, STANDARD DEVIATION, AND NUMBER OF SAMPLES" +        " OF SECOND DISTRIBUTION:"
  186. 5090  L$ = "45": H$ = "57": INLEN = 8: DEFLT$ = "0"
  187. 5100  LOCATE 12,5: PRINT "MEAN:";: LOCATE,12: GOSUB 20000: M2 = VAL(BUFF$)
  188. 5110  LOCATE 12,24: PRINT "STD DEV:";: LOCATE,35: GOSUB 20000: SD2 = VAL(BUFF$)
  189. 5120  LOCATE 12,50: PRINT "N:";: LOCATE,56: INLEN = 4: GOSUB 20000:                     N2 = VAL(BUFF$)
  190. 5130  T = ABS(M1-M2)/SQR((((N1-1)*SD1*SD1+(N2-1)*SD2*SD2)/(N1+N2-2))*((N1+N2)/          (N1*N2)))
  191. 5140  DF = N1 + N2 -2
  192. 5150  GOSUB 6010
  193. 5160  BLINE=14:BCOL=15:BXL=6:BXW=48:LL=0:BORDER=1:LABEL$="":GOSUB 24020
  194. 5170  COLOR 3:LOCATE 16,25: PRINT "t = ";T
  195. 5180  LOCATE 16,45: PRINT PV$
  196. 5190  LOCATE 18,24: PRINT DF;" DEGREES OF FREEDOM":COLOR FC,BC
  197. 5200  COLOR 4,7:LOCATE 22,10:PRINT " PRESS ENTER FOR MORE t-TESTS; PRESS ANY O";        "THER KEY FOR MENU ":COLOR 6,0
  198. 5210  W$ = INKEY$: IF W$ = "" THEN 5210
  199. 5220  IF W$=CHR$(13) THEN 5000 ELSE GOTO 1000
  200. 6000  '                                                                               '------------------------  CALCULATE P(t)  ------------------------------       '
  201. 6010  FOR Z=1 TO 34
  202. 6020    IF TVAL(Z,10)<DF THEN 6080
  203. 6040    FOR ZZ=1 TO 9
  204. 6050      IF ABS(T)>TVAL(Z,ZZ) THEN 6070
  205. 6055      IF ZZ=1 THEN PV$="P > 0.90": RETURN
  206. 6060      PV$="P < "+PVAL$(ZZ-1):RETURN
  207. 6070    NEXT ZZ
  208. 6075    PV$="P < 0.001":RETURN
  209. 6080  NEXT Z
  210. 7999  '                                                                               '--------------------------  PAIRED T-TEST  -----------------------------       '
  211. 8000  SMX=0:SMSQX=0:SMY=0:SMSQY=0:SMDIF=0:TOT=0:SMSQDIF=0:MNX=0:MNY=0:SDX=0:            SDY=0:ERASE X,Y,Z
  212. 8010  FOR M=0 TO 5
  213. 8020    CLS: GOSUB 28000: LOCATE 2,20:COLOR 4:  PRINT "STUDENT t-TEST FOR ";              "PAIRED VARIABLES": COLOR FC
  214. 8030    LOCATE 1: PRINT STRING$(80,196);
  215. 8040    LOCATE 4: PRINT "ENTER PAIRED VARIABLES.  ENTER [ / ] TO END:"
  216. 8050    LOCATE 3: PRINT STRING$(80,196);
  217. 8060    FOR N=0 TO 53
  218. 8070      Z=(N\18)*26:Y=(N MOD 18)+6:Q=M*54+N+1
  219. 8080      LOCATE Y,Z+3:COLOR 0,7:PRINT FNNUM$(Q):COLOR FC,BC
  220. 8090      LOCATE Y,Z+7:INLEN=8:L$="43":H$="57":DEFLT$="0":GOSUB 20000:                      IF BUFF$="/" THEN 8150 ELSE X(Q)=VAL(BUFF$)
  221. 8100      LOCATE Y,Z+17:GOSUB 20000:Y(Q)=VAL(BUFF$)
  222. 8110      Z(Q)=X(Q)-Y(Q):SMDIF=SMDIF+Z(Q):SMSQDIF=SMSQDIF+Z(Q)*Z(Q)
  223. 8120      SMX=SMX+X(Q):SMSQX=SMSQX+X(Q)*X(Q):SMY=SMY+Y(Q):SMSQY=SMSQY+Y(Q)*Y(Q)
  224. 8130    NEXT N
  225. 8140  NEXT M
  226. 8150  TOT=N:NG=0:IF TOT=0 THEN 8160 ELSE MNX=SMX/TOT:MNY=SMY/TOT
  227. 8160  IF TOT=<1 THEN NG=1:Z$=" INSUFFICIENT DATA ":GOTO 8240
  228. 8170  SDX=SQR((SMSQX-SMX*SMX/TOT)/(TOT-1))
  229. 8180  SDY=SQR((SMSQY-SMY*SMY/TOT)/(TOT-1))
  230. 8190  SDDIF=SQR((SMSQDIF-(SMDIF*SMDIF/TOT))/(TOT-1))
  231. 8200  IF SDDIF=0 THEN NG=1:Z$=" VARIANCE = 0;  t = INFINITE ":GOTO 8240
  232. 8210  T=(SMDIF/TOT)/(SDDIF/SQR(TOT))
  233. 8220  DF=TOT-1
  234. 8230  GOSUB 6010:COLOR 3
  235. 8240  FOR N=1 TO 8
  236. 8250    LOCATE 11+N,15:PRINT SPACE$(50)
  237. 8260  NEXT N
  238. 8270  LOCATE 11,15: PRINT STRING$(50,196)
  239. 8280  LOCATE 13,22: PRINT USING "_MEAN X= #####.####_ ±####.####";MNX,SDX
  240. 8290  LOCATE 14,22: PRINT USING "_MEAN Y= #####.####_ ±####.####";MNY,SDY
  241. 8300  IF NG=1 THEN LOCATE 17,25: COLOR 16,7:PRINT Z$:COLOR FC,BC:GOTO 8340
  242. 8310  LOCATE 16,25: PRINT "t = ";T
  243. 8320  LOCATE 16,45: PRINT PV$
  244. 8330  LOCATE 18,24: PRINT DF;" DEGREES OF FREEDOM"
  245. 8340  LOCATE 20,15: PRINT STRING$(50,196):COLOR 1,7
  246. 8350  LOCATE 22,10:PRINT " PRESS ENTER FOR MORE t-TESTS; PRESS ANY OTHER KEY F";        "OR MENU ":COLOR 6,0
  247. 8360  GOSUB 29000
  248. 8370  W$ = INKEY$: IF W$ = "" THEN 8370
  249. 8380  IF W$=CHR$(13) THEN 8000 ELSE GOTO 1000
  250. 8999  '                                                                               '--------------------------  CHI-SQUARE  --------------------------------       '
  251. 9000  MENU=2:BLINE=1:BCOL=29:BXL=2:BXW=18:BORDER=1:LABEL$="":LL=1:GOSUB 24000
  252. 9010  LOCATE 2,30:COLOR 4,7:PRINT" CHI-SQUARE TEST ":COLOR FC,BC
  253. 9020  BLINE=6:BCOL=5:BXL=10:BXW=70:BORDER=1:LABEL$="":LL=0:GOSUB 24020
  254. 9030  LOCATE 8,10:PRINT "BOX 1:":LOCATE 8,20:INLEN=8:L$="46":H$="57":DEFLT$="0":        GOSUB 20000:B1=VAL(BUFF$)
  255. 9040  LOCATE 8,35:PRINT "BOX 2:":LOCATE 8,45:GOSUB 20000:B2=VAL(BUFF$)
  256. 9050  LOCATE 11,10:PRINT "BOX 3:":LOCATE 11,20:GOSUB 20000:B3=VAL(BUFF$)
  257. 9060  LOCATE 11,35:PRINT "BOX 4:":LOCATE 11,45:GOSUB 20000:B4=VAL(BUFF$)
  258. 9070  B12=B1+B2:B34=B3+B4:B13=B1+B3:B24=B2+B4:BB=B12+B34:E12=B12/BB:E34=B34/BB:        E1=B13*E12:E2=B24*E12:E3=B13*E34:E4=B24*E34:
  259. 9080  LOCATE 8,60:PRINT B12:LOCATE 11,60:PRINT B34:LOCATE 14,20:PRINT B13:             LOCATE 14,45:PRINT B24:LOCATE 14,60:PRINT BB
  260. 9090  CHSQ!=(B1-E1)*(B1-E1)/E1+(B2-E2)*(B2-E2)/E2+(B3-E3)*(B3-E3)/E3+(B4-E4)*(B4        -E4)/E4
  261. 9100  LOCATE 19,10:COLOR 4,7:PRINT "CHI SQUARE =";CHSQ!:COLOR 6,0
  262. 9110  LOCATE 23,10:COLOR 1,7:PRINT " PRESS [ ENTER ] FOR MORE CHI-SQUARE; PRE";         "SS ANY OTHER KEY FOR MENU ":COLOR 6,0
  263. 9120  W$=INKEY$:IF W$="" THEN 9120
  264. 9130  IF W$=CHR$(13) THEN 9000 ELSE GOTO 1000
  265. 14999  '                                                                               '------------------------  OPENING MESSAGE  ----------------------------        '
  266. 15000  BLINE=1:BCOL=1:BXL=21:BXW=79:LL=0:BORDER=2:LABEL$="":GOSUB 24000
  267. 15010  LOCATE 3,27:COLOR 12:PRINT"WELCOME TO STATZ v.1.3
  268. 15020  LOCATE 5,29:PRINT"by Bob Barth, 1987"
  269. 15030  COLOR 6,0
  270. 15040  LOCATE 7,10:PRINT"STATZ is designed to do simple keyboard-entry statistics; its"
  271. 15050  LOCATE 8,10:PRINT"is menu-driven and its operation should be self-explanatory."
  272. 15060  LOCATE 9,10:PRINT"The program itself is written in QuickBASIC; for those who"
  273. 15070  LOCATE 10,10:PRINT"enjoy tinkering, source code in GWBASIC is included (STATZ13.BAS)."
  274. 15080  LOCATE 12,10:PRINT"STATZ is a public domain program for the use of whoever finds"
  275. 15090  LOCATE 13,10:PRINT"it useful.  I would, of course, appreciate hearing about any"
  276. 15100  LOCATE 14,10:PRINT"problems that might crop up, at the following address:"
  277. 15110  LOCATE 16,15:PRINT"Solidarity Software"
  278. 15120  LOCATE 17,15:PRINT"187 E. 4th St. #3M"
  279. 15130  LOCATE 18,15:PRINT"New York, NY 10009"
  280. 15140  LOCATE 19,15:PRINT"Tel: (8-6)     718-836-6600 ext 134 or 572"
  281. 15150  LOCATE 20,15:PRINT"     (after 7) 212-475-0872"
  282. 15160  RETURN
  283. 19000  '                                                                               '------------------------  DATA STATEMENTS  ----------------------------        '
  284. 19010 DATA .158,1,   1.376,3.078,6.314,12.706,31.821,63.657,636.619,1
  285. 19015 DATA .142,.816,1.061,1.886,2.920,4.303,6.965,9.925,31.598,2
  286. 19020 DATA .137,.765,.978,1.638,2.353,3.182,4.541,5.841,12.924,3
  287. 19025 DATA .134,.741,.941,1.533,2.132,2.776,3.747,4.604,8.610,4
  288. 19030 DATA .132,.727,.920,1.476,2.015,2.571,3.365,4.032,6.869,5
  289. 19035 '
  290. 19040 DATA .131,.718,.906,1.440,1.943,2.447,3.143,3.707,5.959,6
  291. 19045 DATA .130,.711,.896,1.415,1.895,2.365,2.998,3.499,5.408,7
  292. 19050 DATA .130,.706,.889,1.397,1.860,2.306,2.896,3.355,5.041,8
  293. 19055 DATA .129,.703,.883,1.383,1.833,2.262,2.821,3.250,4.781,9
  294. 19060 DATA .129,.700,.879,1.372,1.812,2.228,2.764,3.169,4.587,10
  295. 19065 '
  296. 19070 DATA .129,.697,.876,1.363,1.796,2.201,2.718,3.106,4.437,11
  297. 19075 DATA .128,.695,.873,1.356,1.782,2.179,2.681,3.055,4.318,12
  298. 19080 DATA .128,.694,.870,1.350,1.771,2.160,2.650,3.012,4.221,13
  299. 19085 DATA .128,.692,.868,1.345,1.761,2.145,2.624,2.977,4.140,14
  300. 19090 DATA .128,.691,.866,1.341,1.753,2.131,2.602,2.947,4.073,15
  301. 19095 '
  302. 19100 DATA .128,.690,.865,1.337,1.746,2.120,2.583,2.921,4.015,16
  303. 19105 DATA .128,.689,.863,1.333,1.74,2.11,2.567,2.898,3.965,17
  304. 19110 DATA .127,.688,.862,1.330,1.734,2.101,2.552,2.878,3.922,18
  305. 19115 DATA .127,.688,.861,1.328,1.729,2.093,2.539,2.861,3.883,19
  306. 19120 DATA .127,.687,.860,1.325,1.725,2.086,2.528,2.845,3.850,20
  307. 19125 '
  308. 19130 DATA .127,.686,.859,1.323,1.721,2.080,2.518,2.831,3.819,21
  309. 19135 DATA .127,.686,.858,1.321,1.717,2.074,2.508,2.819,3.792,22
  310. 19140 DATA .127,.685,.858,1.319,1.714,2.069,2.500,2.807,3.767,23
  311. 19145 DATA .127,.685,.857,1.318,1.711,2.064,2.492,2.797,3.745,24
  312. 19150 DATA .127,.684,.856,1.316,1.708,2.060,2.485,2.787,3.725,25
  313. 19155 '
  314. 19160 DATA .127,.684,.856,1.315,1.706,2.056,2.479,2.779,3.707,26
  315. 19165 DATA .127,.684,.855,1.314,1.703,2.052,2.473,2.771,3.690,27
  316. 19170 DATA .127,.683,.855,1.313,1.701,2.048,2.462,2.763,3.674,28
  317. 19175 DATA .127,.683,.854,1.311,1.699,2.045,2.462,2.756,3.659,29
  318. 19180 DATA .127,.683,.854,1.310,1.697,2.042,2.457,2.750,3.646,30
  319. 19185 '
  320. 19190 DATA .126,.681,.851,1.303,1.684,2.021,2.423,2.704,3.551,40
  321. 19195 DATA .126,.679,.848,1.296,1.671,2.000,2.390,2.660,3.460,60
  322. 19200 DATA .126,.677,.845,1.289,1.658,1.980,2.358,2.617,3.373,120
  323. 19205 DATA .126,.674,.842,1.282,1.645,1.960,2.326,2.576,3.291,99999
  324. 19250 '
  325. 19260 DATA "0.90","0.50","0.40","0.20","0.10","0.05","0.02","0.01","0.001"
  326. 19999 '                                                                               '**************************  INPUT ROUTINE  *****************************       '
  327. 20000 COLOR 31
  328. 20001 CTRL.H$=CHR$(29):CR.RET$=CHR$(13):UNDRLN$=CHR$(95):ESC$=CHR$(27):                 CTRL.X$=CHR$(24):BKSPC$=CTRL.H$+UNDRLN$+CTRL.H$:                                BUFF$="":PRINT STRING$(INLEN,UNDRLN$);:LOCATE,POS(N)-INLEN
  329. 20010 W$=INPUT$(1):                                                                     IF ASC(W$)>96 THEN W$=CHR$(ASC(W$)-32)
  330. 20015   IF ASC(W$)>=VAL(L$)AND ASC(W$)<=VAL(H$)THEN 20070
  331. 20020 IF W$<>CHR$(8)THEN 20030
  332. 20025   IF BUFF$=""THEN 20010                                                           ELSE BUFF$=LEFT$(BUFF$,LEN(BUFF$)-1):LOCATE,POS(N)-1: PRINT UNDRLN$;:             LOCATE,POS(N)-1: GOTO 20010
  333. 20030 IF W$<>CR.RET$THEN 20050                                                          ELSE PRINT STRING$(INLEN-LEN(BUFF$)," ");
  334. 20040   IF BUFF$=""THEN BUFF$=DEFLT$:                                                     FOR XJ=1 TO INLEN:PRINT CTRL.H$;:NEXT XJ:COLOR 7:PRINT DEFLT$;:                 COLOR FC:RETURN ELSE COLOR FC:RETURN
  335. 20050 IF W$=CTRL.X$THEN                                                                   FOR XJ=1 TO LEN(BUFF$):PRINT BKSPC$;:NEXT XJ:BUFF$="":GOTO 20010
  336. 20060 IF W$=ESC$AND MENU<>0 THEN COLOR FC:RESET:GOTO 1000                                 ELSE IF W$=ESC$THEN CLS:SYSTEM
  337. 20062 IF W$=CHR$(9) THEN COLOR 6:DEF SEG=0:POKE 1047,(PEEK(1047) AND 223):STOP
  338. 20065 GOTO 20010
  339. 20070 IF LEN(BUFF$)=INLEN THEN 20010                                                      ELSE COLOR 7:PRINT W$;:BUFF$=BUFF$+W$:COLOR 31:GOTO 20010
  340. 20499 '                                                                               '------------------------ PAUSE MESSAGE SUBROUTINE ----------------------       '
  341. 20500 BLINE=10:BCOL=10:BXL=4:BXW=59:LABEL$="":LL=0:BORDER=2:GOSUB 24000:LOCATE          12,25:COLOR 0,6:PRINT"  BE PATIENT:  A SHORT PAUSE  ":COLOR FC,BC:RETURN
  342. 24000  '                                                                               '************************* BOX SUBROUTINE ******************************        '
  343. 24010  'VARIABLES: BXW = WIDTH OF BOX     LABEL$ = TITLE    BORDER = 1 (LINES)                     BXL = HEIGHT OF BOX    BLINE,BCOL = COORDINATES OF UPPER                        LL  = SCREEN LABEL (0,1)            LEFT CORNER
  344. 24012  '                   A$ -------- X$ -------- B$                                                      Y$                      Z$                                                      C$ -------- W$ -------- D$
  345. 24015  CLS
  346. 24020  IF BORDER=1 THEN X$="─":Y$="│":Z$="│":W$="─":A$="┌":B$="┐":C$="└":D$="┘":         E$="┤":F$="├"
  347. 24030  IF BORDER=2 THEN X$="═":Y$="║":Z$="║":W$="═":A$="╔":B$="╗":C$="╚":D$="╝":         E$="╡":F$="╞"
  348. 24040  IF BORDER=3 THEN X$="▀":Y$="█":Z$="█":W$="▄":A$=Y$:B$=Y$:C$=Y$:D$=Y$:E$=          "▌":F$="▐"
  349. 24050  IF BORDER=4 THEN Y$="░":X$=Y$:Z$=Y$:W$=Y$:A$=Y$:B$=Y$:C$=Y$:D$=Y$:E$=Y$:          F$=Y$
  350. 24060  IF BORDER=5 THEN Y$="▒":X$=Y$:Z$=Y$:W$=Y$:A$=Y$:B$=Y$:C$=Y$:D$=Y$:E$=Y$:          F$=Y$
  351. 24070  IF BORDER=6 THEN Y$="▓":X$=Y$:Z$=Y$:W$=Y$:A$=Y$:B$=Y$:C$=Y$:D$=Y$:E$=Y$:          F$=Y$
  352. 24080  IF LL=1 THEN GOSUB 28000
  353. 24085  IF LABEL$="" THEN E$=X$:F$=X$
  354. 24090  LOCATE BLINE, BCOL: COLOR 14,BC: PRINT STRING$(((BXW - LEN(LABEL$))/2)-1,         X$);E$;:COLOR BC,14:PRINT LABEL$;:COLOR 14,BC:PRINT F$;STRING$(((BXW -          LEN(LABEL$))/2)-1,X$)
  355. 24100  LOCATE BLINE,BCOL: PRINT A$: LOCATE BLINE, BCOL + BXW: PRINT B$
  356. 24110  FOR K = BLINE +1 TO BLINE + BXL
  357. 24120    LOCATE K,BCOL: PRINT Y$: LOCATE K,BCOL + BXW: PRINT Z$
  358. 24130  NEXT K
  359. 24140  LOCATE BLINE + BXL,BCOL: PRINT C$: LOCATE BLINE + BXL, BCOL + BXW: PRINT          D$;
  360. 24150  LOCATE BLINE + BXL, BCOL + 1: PRINT STRING$(BXW-1, W$);
  361. 24160  COLOR FC,BC: RETURN
  362. 27000 '                                                                               '************************** SAVE SUBROUTINE *****************************       '
  363. 27005 ' COLOR 4,7
  364. 27007 ' PROG$ = "BARTH\KEYSTAT.BAS"
  365. 27010 ' PRINT">>>  SAVING ";CHR$(34);PROG$;CHR$(34);"  <<<";: COLOR 6,BC:                   PRINT SPACE$(61-LEN(PROG$))
  366. 27020 ' SAVE PROG$
  367. 27030 END
  368. 28000  '                                                                               '**********************SCREEN LABEL FOR INPUT***************************        '
  369. 28010  IF MENU=0 THEN LOCATE 25,27:ELSE IF MENU=1 THEN LOCATE 25,8 ELSE IF               MENU=2 THEN LOCATE 25,18
  370. 28015        COLOR 1,7:IF MENU=0 THEN PRINT"[ESC] TO RETURN TO DOS";:COLOR FC,BC             :RETURN ELSE PRINT"[ESC] FOR MAIN MENU";
  371. 28020        COLOR FC,BC:IF MENU=1 THEN PRINT SPACE$(5);:                                    COLOR 1,7:PRINT"[ / ] TO END ENTRY";
  372. 28030        COLOR FC,BC: PRINT SPACE$(5);:                                                  COLOR 1,7: PRINT "[ F10 ] TO DELETE LINE";:                                     COLOR FC,BC: PRINT SPACE$(6);
  373. 28040  RETURN
  374. 28999  '                                                                               '**************************KEYBOARD CLEAR*******************************        '
  375. 29000  WHILE INKEY$ <> ""
  376. 29010    DISCARD$ = INKEY$
  377. 29020  WEND
  378. 29030  RETURN
  379.